#!/usr/bin/perl -wc

package RFCMail::ESMTP::Server::ResearchAssistant;

use strict;
use File::Spec::Functions qw(curdir rel2abs catdir catfile);
use IO::File;
use Data::Dumper;
use RFCMail::Util::FileDump;

my $PRIVATE = __PACKAGE__;


sub init {
    my $self = shift;
    $self->SUPER::init(@_);
    $self->{research_dir} = curdir()
	if not defined($self->{research_dir});
    # rel2abs() output can be tainted
    rel2abs($self->{research_dir}) =~ m'(.+)';
    $self->{research_dir} = $1;
    $self->{research_dirmode} = 0700
	if not defined($self->{research_dirmode});
}


sub session {
    my $self = shift;
    eval {
	my $session_id = $self->{state}->{Session_ID};
	# Make session_dir in research_dir
	my $session_dir = catdir($self->{research_dir}, $session_id);
	mkdir($session_dir, $self->{research_dirmode})
	    or die "can't create session dir '$session_dir': $!\n";
	$self->{$PRIVATE}->{session_dir} = $session_dir;
	# Make logfile in research_dir
	my $logfile = IO::File->new(catfile($session_dir, "logfile"), ">")
	    or die "can't create logfile in '$session_dir': $!";
	$self->{$PRIVATE}->{logfile} = $logfile;
	_log_entry($self, qw(- begin), $session_id);
    };
    $self->logmsg(e => __PACKAGE__."->session trouble...", $@)
	if $@;
    return ($self->SUPER::session(@_));
}


sub data_start {
    my $self = shift;
    eval {
	my $trans_id = $self->{state}->{trans_id};
	_log_entry($self, qw(- data start), $trans_id);
	my $data_dir = catdir($self->{$PRIVATE}->{session_dir}, $trans_id);
	die "supposedly unique dir '$data_dir' already exists\n"
	    if -d $data_dir;
	mkdir($data_dir, $self->{research_dirmode})
	    or die "can't create incoming dir '$data_dir': $!\n";
	dump_data_to_file(catfile($data_dir, 'env'),
			  $self->{state});
	dump_to_file_as_lines(catfile($data_dir, 'stamp'),
			      $self->data_stamp);
	my $datafile = catfile($data_dir, 'data');
	my $file = IO::File->new($datafile, ">")
	    or die "can't create 'data' file '$datafile': $!\n";
	$self->{$PRIVATE}->{datafile} = $file;
    };
    $self->logmsg(e => __PACKAGE__."->data_start trouble...", $@)
	if ($@);
    return ($self->SUPER::data_start(@_));
}


sub data_line {
    my $self = shift;
    if (exists($self->{$PRIVATE}->{datafile})) {
	if (not $self->{$PRIVATE}->{datafile}->print(@_, "\n")) {
	    $self->logmsg(e => __PACKAGE__."->data_line trouble: $!",
			  "data logging stops at this point");
	    delete($self->{$PRIVATE}->{datafile});
	}
    }
    $self->SUPER::data_line(@_);
}


sub data_finish {
    my $self = shift;
    _log_entry($self, qw(- data finish));
    delete($self->{$PRIVATE}->{datafile})->close()
	if exists($self->{$PRIVATE}->{datafile});
    return ($self->SUPER::data_finish(@_));
}


sub data_commit {
    my $self = shift;
    _log_entry($self, qw(- data commit));
    $self->SUPER::data_commit(@_);
}


sub data_abort {
    my $self = shift;
    _log_entry($self, qw(- data abort));
    delete($self->{$PRIVATE}->{datafile})->close()
	if exists($self->{$PRIVATE}->{datafile});
    $self->SUPER::data_abort(@_);
}


sub logmsg {
    my $self = shift;
    $self->SUPER::logmsg(@_);
    my $level = shift;
    for (@_) { _log_entry($self, "l", $level, $_) }
}


sub hansard {
    my $self = shift;
    $self->SUPER::hansard(@_);
    for (@_) { _log_entry($self, "h", $_) }
}


sub cleanup {
    my $self = shift;
    $self->SUPER::cleanup;
    _log_entry($self, qw(- end));
    delete($self->{$PRIVATE});
}


sub _log_entry {
    my $self = shift;
    $self->{$PRIVATE}->{logfile}->print(join(" ", time(), @_), "\n")
	if exists($self->{$PRIVATE}->{logfile});
}


1;
